home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Info-Mac 4
/
Info_Mac IV CD-ROM (Pacific HiTech Inc.)(August 1994).iso
/
Development
/
General
/
ViewIt™ 2.24 Shareware
/
FORTRAN Demo Projects
/
Absoft MacFortran II 3.2 Demos
/
vDemoAF.f
< prev
next >
Wrap
Text File
|
1993-09-21
|
5KB
|
146 lines
C NOTE: Read the "MPW Fortrans" section of "About Compilers"
C before compiling AF programs that use FaceWare modules.
C ViewIt 2.2 Demonstration Program
C ©FaceWare 1991-93. All Rights Reserved.
GLOBAL DEFINE
include "Types.inc"
include "QuickDraw.inc"
include "Controls.inc"
include "Events.inc"
include "OSUtils.inc"
include "OSEvents.inc"
include "SegLoad.inc"
include "Files.inc"
include "Resources.inc"
include "FaceStorAF.inc"
END
include "FaceProcAF.inc"
PROGRAM vDemoAF
implicit none
record /FaceRec/ fRec
common/FaceStuff/fRec
structure /DataRec/
integer*2 myInteger
real*4 myReal
character*100 myString
integer*4 myFlags
end structure
record/DataRec/myRec
real*4 theReal,delta
logical*4 helpShown
integer*2 myList
integer*4 myPtr,oldTicks,newTicks
integer*4 OverProc
pascal external OverProc
myRec.myInteger = 0
myRec.myReal = 6.2
myRec.myString = 'Hello'
myRec.myFlags = 10
myList = 2
oldTicks = 0
theReal = 6.0
C Initialize FaceIt
fRec.uName = 'vDemo.Rsrc'
call FaceIt(0,DoInit,0,0,0,0)
C Open Modeless Window using FWND 1000
call FaceIt(0,NewWnd,1000,1,0,0)
do while (.true.)
call FaceIt(0,DoLoop,0,0,0,0)
C Standard "About" Menu Item Selection
if ((fRec.uMenuID == 101).and.(fRec.uMenuItem == 1)) then
fRec.uString = 'Demonstration of the use of ViewIt'
+//char(13)//'windows in a FaceIt-based program.'
call FaceIt(0,ShoStr,3,12,(1 + (409*65536)),0)
C Hit in Modeless Window's "Open Modal" Button
else if ((fRec.uMenuID == 1000).and.(fRec.wcHit == 2)) then
call FaceIt(0,NewWnd,1001,0,0,0) !Open Modal Window
do while (.true.)
call FaceIt(0,MdlWnd,1001,0,0,0) !Process Modal Events
if (fRec.wcHit == -1) then !Hit in Close Box
exit
else if (fRec.wcHit == 1) then !Hit in "Open Nested"
myPtr = %loc(myRec)
call FaceIt(0,NewWnd,1002,0,110,myPtr)!Open Nested Modal
call FaceIt(0,GetCtl,1002,0,3,3) !Link Scrollable List
call FaceIt(0,LnkCtl,fRec.cControl,%loc(myList),2,0)
call FaceIt(0,GetCtl,1002,0,2,3) !Set Override Proc
call FaceIt(0,OvrCtl,fRec.cControl,OverProc,0,0)
call FaceIt(0,SetVal,1002,0,0,0) !Set Linked Values
helpShown = .false.
do while (.true.)
call FaceIt(0,MdlWnd,1002,-2,0,0) !Process Modal Events
if (fRec.uMenuID == 0) then !No Message
newTicks = TickCount()
if (newTicks > oldTicks + 60) then
oldTicks = newTicks
call FaceIt(0,GetCtl,1002,0,2,8)
call SetCtlValue(%val4(fRec.cControl),
+ %val2(mod(fRec.cValue,4) + 1))
end if
else if (fRec.wvHit == 1) then !Hit in View #1
if (fRec.wcHit == 1) then !Hit in "OK" Button
exit
else if (fRec.wcHit == 2) then !Hit in "Show/Hide"
if (helpShown) then
call FaceIt(0,ShoCtl,0,0,-3,2) !Hide v3, Show v2
helpShown = .false.
else
call FaceIt(0,ShoCtl,0,0,-2,3) !Hide v2, Show v3
helpShown = .true.
end if
end if
else if (fRec.wvHit == 2) then !Hit in View #2
if ((fRec.wcHit == 6).or.(fRec.wcHit == 7)) then
call FaceIt(0,GetCtl,1002,0,2,int(fRec.wcHit))
delta = 0.001 * (fRec.cMin - 2)
myRec.myReal = myRec.myReal + delta
call FaceIt(0,SetVal,0,0,2,2)
call Delay(%val4(5),fRec.uI4)
end if
end if
end do
call FaceIt(0,GetVal,1002,0,0,0) !Get Linked Values
call FaceIt(0,EndWnd,1002,0,0,0) !Close Nested Modal
end if
end do
call FaceIt(0,EndWnd,1001,0,0,0) !Close Modal Window
C Hit in Modeless Window's "Why ViewIt?" Button
else if ((fRec.uMenuID == 1000).and.(fRec.wcHit == 3)) then
call FaceIt(0,NewWnd,1003,0,0,%loc(theReal))
call FaceIt(0,SetVal,1003,0,0,0)
do while (.true.)
call FaceIt(0,MdlWnd,1003,0,0,0)
if (fRec.wcHit == 1) exit
end do
call FaceIt(0,GetVal,1003,0,0,0)
call FaceIt(0,EndWnd,1003,0,0,0)
end if
end do
end
C NOTE: Use of a procedure like "OverProc" that is called by ViewIt
C requires that it be compiled with the "-k" option set. See your
C MacFortran II manual for more info about the "-k" compiler option.
PASCAL SUBROUTINE OverProc(thePtr)
value thePtr
implicit none
integer*4 JumpIt,thePtr
inline (JumpIt = /z'2257',z'2051',z'4e90'/)
record /FaceRec/ fRec
common/FaceStuff/fRec
if (fRec.uCommand == 264) then !a key down message?
if (fRec.uParam(1) == 32) then !SPACE key pressed?
fRec.uParam(1) = 95 !convert to UNDERLINE
end if
end if
call JumpIt(%val4(thePtr)) !pass message to driver
end